Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/drawer.zip/DRAWER.PAS

Pascal/Delphi Source File | 1993-01-04 | 10KB | 549 lines

{$L-,D-}
Program Drawer;

Uses
    MSGraph, Shape, Canvas, CommWell,
    ColorBar, Event, Dragger, Dialog, Crt;

const
    MWIDTH            = 60;

type

    Handler = procedure( E : Event);

var
    vc             : _VideoConfig;
    cx, cy        : word;
    CW             : CommWell;
    FCW            : CommWell;
    CB             : ColorBar;
    Can         : Canvas;
    MHandler     : Handler;
    ColorShape     : GText;
    Drag         : Dragger;
    BDrag         : BDragger;
    CurDrag        : Dragger;
    GlobalState    : (Idling, Creating, Selecting, Moving, Sizing, Done);
    GlobalShape    : (None, Rect, FRect, Ell, FEll, Lin, Txt);

{$F+}
procedure HandleSelector( E : Event);
var
    x1, y1, x2, y2 : word;
    dx, dy : integer;
begin
    if E.typ = LBUTTONDOWN then begin
        CurDrag := BDrag;
        if Can.PtInSelection(E.x, E.y) then begin
            Can.GetRange( x1, y1, x2, y2);
            if Can.OnHandle( E.x, E.y) then begin
                { we've got a size operation}
                GlobalState := Sizing;
                BDrag.Initialize( Size, x1, y1, x2, y2);
                end
            else begin
                { we've got a move operation }
                GlobalState := Moving;
                BDrag.Initialize( Move, x1, y1, x2, y2);
                end;
            end
        else begin
            GlobalState := Selecting;
            Can.UnSelectAllObjects;
            BDrag.Initialize( Size, E.x, E.y, E.x, E.y);
            end;
        CurDrag.StartDrag( E.x, E.y);
        end
    else if E.typ = LBUTTONUP then begin
        BDrag.GetRange(x1, y1, x2, y2);
        CurDrag.EndDrag( E.x, E.y );
        if GlobalState=Moving then begin
            dx := x2 - x1;
            dy := y2 - y1;
            Can.Move( dx, dy);
            Can.Erase;
            Can.Draw;
            end
        else if GlobalState=Sizing then begin
            dx := x2 - x1;
            dy := y2 - y1;
            Can.Size( dx, dy );
            Can.Erase;
            Can.Draw;
            end
        else
            { must be selecting }
            Can.Lasso(x1, y1, x2, y2);
        CurDrag := NIL;
        GlobalState := Idling;
        end
    else if CurDrag<>NIL then CurDrag.Drag(E.x, E.y);

end;

procedure HandleQShapes( E : Event);
var
    r  : rectangle;
    fr : FRectangle;
    el : Ellipse;
    fe : FEllipse;
    s  : Shape;
    x1, y1, x2, y2 : word;
begin
    if E.typ = LBUTTONDOWN then begin
        GlobalState := Creating;
        CurDrag := BDrag;
        Can.UnSelectAllObjects;
        BDrag.Initialize( Size, E.x, E.y, E.x, E.y);
        CurDrag.StartDrag( E.x, E.y);
        end
    else if (E.typ = LBUTTONUP) then begin
        GlobalState := Idling;
        CurDrag.EndDrag( E.x, E.y );
        BDrag.GetRange(x1, y1, x2, y2);
        CurDrag := NIL;
        case GlobalShape of
            Rect : begin
                    new(r);
                    s := r;
                   end;
            FRect : begin
                    new(fr);
                    s := fr;
                   end;
            Ell : begin
                    new(el);
                    s := el;
                   end;
            FEll : begin
                    new(fe);
                    s := fe;
                   end;
            end;
        s.Initialize( x1, y1, x2-x1, y2-y1, CB.GetColor);
        if Can.AddShape(s) then begin
            s.Draw;
            Can.SelectObject(s)
            end
        else Dispose(s);
        end
    else if CurDrag<>NIL then CurDrag.Drag( E.x, E.y);
end;

procedure HandleText( E : Event);
var
    T : GText;
    P : Prompter;
    x1, y1, x2, y2 : word;
begin
    if E.typ = LBUTTONDOWN then begin
        GlobalState := Creating;
        CurDrag := BDrag;
        Can.UnSelectAllObjects;
        BDrag.Initialize( Size, E.x, E.y, E.x, E.y);
        CurDrag.StartDrag( E.x, E.y);
        end
    else if (E.typ = LBUTTONUP) then begin
        GlobalState := Idling;
        CurDrag.EndDrag( E.x, E.y );
        BDrag.GetRange(x1, y1, x2, y2);
        CurDrag := NIL;
        new(P);
        P.Initialize( 5, 15, 50,'Text:');
        if P.Process then begin
            new(T);
            T.Initialize( x1, y1, x2-x1, y2-y1, CB.GetColor);
            T.SetText(P.Response);
            if Can.AddShape(T) then begin
                T.Draw;
                Can.SelectObject(T);
                end
            else
                Dispose(T);
            end;
        Dispose(P);
        end
    else if CurDrag<>NIL then CurDrag.Drag( E.x, E.y);
end;

procedure HandleLine( E : Event);
var
    l  : Line;
    x1, y1, x2, y2 : word;
begin
    if E.typ = LBUTTONDOWN then begin
        GlobalState := Creating;
        Can.UnSelectAllObjects;
        CurDrag := Drag;
        CurDrag.StartDrag( E.x, E.y);
        end
    else if (E.typ = LBUTTONUP) then begin
        GlobalState := Idling;
        CurDrag.EndDrag( E.x, E.y );
        Drag.GetRange(x1, y1, x2, y2);
        CurDrag := NIL;
        new(l);
        l.Initialize( x1, y1, x2-x1, y2-y1, CB.GetColor);
        if Can.AddShape(l) then begin
            l.Draw;
            Can.SelectObject(l);
            end
        else
            Dispose(l);
        end
    else if CurDrag<>NIL then CurDrag.Drag( E.x, E.y);
end;

procedure ChoseSelector;
begin
    GlobalShape := None;
    MHandler := HandleSelector;
end;

procedure ChoseRectangle;
begin
    GlobalShape := Rect;
    MHandler := HandleQShapes;
end;

procedure ChoseFRectangle;
begin
    GlobalShape := FRect;
    MHandler := HandleQShapes;
end;

procedure ChoseEllipse;
begin
    GlobalShape := Ell;
    MHandler := HandleQShapes;
end;

procedure ChoseFEllipse;
begin
    GlobalShape := FEll;
    MHandler := HandleQShapes;
end;

procedure ChoseLine;
begin
    GlobalShape := Lin;
    MHandler := HandleLine;
end;

procedure ChoseText;
begin
    GlobalShape := Txt;
    MHandler := HandleText;
end;

procedure ChoseColors;
var
    E : Event;
begin
    GlobalShape := None;
    CW.SelectItem(1);
    ChoseSelector;
    CW.Erase;
    CB.Draw;
    ShowPointer;
    while TRUE do begin
        GetEvent(E);
        if (E.typ = LBUTTONUP) and
            CB.PtInRegion( E.x, E.y) then begin
                CB.Process( E.x, E.y);
                HidePointer;
                if Can.SelectedObject(NIL)=NIL then
                    ColorShape.color := CB.GetColor
                else begin
                    Can.ChangeColor( CB.GetColor );
                    Can.Erase;
                    Can.Draw;
                    end;
                CB.Erase;
                CW.Draw;
                exit;
                end;
        end;
end;

procedure ChoseDelete;
begin
    GlobalShape := None;
    Can.Delete;
    Can.Erase;
    Can.Draw;
    CW.SelectItem(1);
    ChoseSelector;
end;

procedure ChoseCopy;
begin
    GlobalShape := None;
    Can.Copy;
    Can.Erase;
    Can.Draw;
    CW.SelectItem(1);
    ChoseSelector;
end;

procedure ChoseRedraw;
begin
    GlobalShape := None;
    Can.Erase;
    Can.Draw;
    CW.SelectItem(1);
    ChoseSelector;
end;

procedure ChoseFile;
var
    E : Event;
begin
    GlobalShape := None;
    CW.SelectItem(1);
    ChoseSelector;
    CW.Erase;
    FCW.Draw;
    ShowPointer;
    while TRUE do begin
        GetEvent(E);
        HidePointer;
        { Check if menu item.  If so, let file command well do it }
        if (E.typ=LBUTTONDOWN) and FCW.PtInRegion( E.x, E.y) then begin
                repeat GetEvent(E) until E.typ=LBUTTONUP;
                if FCW.PtInRegion( E.x, E.y) then FCW.Process( E.x, E.y);
                { now get out }
                FCW.SelectItem(0);
                FCW.Erase;
                CW.Draw;
                exit;
                end;
        ShowPointer;
        end;
end;

procedure ChoseQuit;
begin
    GlobalShape := None;
    GlobalState := Done;
    CW.SelectItem(1);
    ChoseSelector;
end;

function GetFileName( var fn : string) : boolean;
var
    p : Prompter;
begin
    new(p);
    p.Initialize( 5, 15, 40, 'Filename:');
    GetFileName := p.Process;
    fn := p.Response;
end;

procedure ChoseFNew;
begin
    Can.SelectAllObjects;
    Can.Delete;
    Can.Erase;
{    Can.Draw; }
end;

procedure ChoseFOpen;
var
    fn : string;
begin
    if GetFileName(fn) then Can.Load(fn);
end;

procedure ChoseFSave;
var
    fn : string;
begin
    if GetFileName(fn) then Can.Save(fn);
end;

procedure ChoseFCancel;
begin
end;

{$F-}

procedure CreateCommWell;
const
    NUMCOMMANDS = 13;
var
    s  : Selector;
    r  : Rectangle;
    fr : FRectangle;
    e  : Ellipse;
    fe : FEllipse;
    l  : Line;
    t  : GText;
begin
    new(CW);
    CW.Initialize( (vc.numypixels-1) div numcommands, MWIDTH, vc.numcolors-1);

    new(s);
    CW.AddCommand( s, ChoseSelector);

    new(r);
    CW.AddCommand( r, ChoseRectangle);

    new(fr);
    CW.AddCommand( fr, ChoseFRectangle);

    new(e);
    CW.AddCommand( e, ChoseEllipse);

    new(fe);
    CW.AddCommand( fe, ChoseFEllipse);

    new(l);
    CW.AddCommand( l, ChoseLine);

    new(t);
    CW.AddCommand( t, ChoseText );
    t.SetText('Text');
    t.SetHeight( cy );

    new(ColorShape);
    CW.AddCommand( ColorShape, ChoseColors );
    ColorShape.SetText('Colors...');
    ColorShape.SetHeight( cy );

    new(t);
    CW.AddCommand( t, ChoseDelete );
    t.SetText('Delete');
    t.SetHeight( cy );

    new(t);
    CW.AddCommand( t, ChoseCopy );
    t.SetText('Copy');
    t.SetHeight( cy );

    new(t);
    CW.AddCommand( t, ChoseRedraw );
    t.SetText('Redraw');
    t.SetHeight( cy );

    new(t);
    CW.AddCommand( t, ChoseFile);
    t.SetText('File...');
    t.SetHeight( cy );

    new(t);
    CW.AddCommand( t, ChoseQuit);
    t.SetText('Quit');
    t.SetHeight( cy );

    CW.Draw;
    CW.SelectItem(1);
    CW.Menu[1].DoIt;
end;


procedure CreateFCommWell;
const
    NUMCOMMANDS = 4;
var
    t  : GText;
begin
    new(FCW);
    FCW.Initialize( (vc.numypixels-1) div numcommands, MWIDTH, vc.numcolors-1);

    new(t);
    FCW.AddCommand( t, ChoseFNew );
    t.SetText('New');
    t.SetHeight( cy );

    new(t);
    FCW.AddCommand( t, ChoseFOpen );
    t.SetText('Open...');
    t.SetHeight( cy );

    new(t);
    FCW.AddCommand( t, ChoseFSave );
    t.SetText('Save...');
    t.SetHeight( cy );

    new(t);
    FCW.AddCommand( t, ChoseFCancel);
    t.SetText('Cancel');
    t.SetHeight( cy );
end;

procedure Initialize;
var
    vidrows : Integer;
    numfonts : integer;
begin
    { initialize CRT unit }
    DirectVideo := FALSE;

    { initialize MSGraph unit }
    vidrows := _SetVideoMode( _ERESCOLOR );
    numfonts := _RegisterFonts( '*.fon');
    _GetVideoConfig( vc );

    { initialize screen dependent parameters }
    cx := vc.numxpixels div 80;
    cy := vc.numypixels div 25;

    { initialize the event processor }
    EnableEvents;

    { initialize canvas }
    new(Can);
    Can.Initialize( MWIDTH+1, 0, vc.numxpixels-1, vc.numypixels-1);

    { initialize command wells }
    CreateCommWell;
    CreateFCommWell;

    { initialize color bar }
    new(CB);
    CB.Initialize( (vc.numypixels-1) div vc.numcolors, MWIDTH, vc.numcolors);

    { Create Dragger objects }
    new(Drag);
    new(BDrag);

end;

procedure Finalize;
var
    vidrows : Integer;
begin
    DisableEvents;
    vidrows := _SetVideoMode( _DEFAULTMODE );
end;

procedure ProcessEvents;
label
    DoneWithEvent;
var
    E : Event;
begin
    CurDrag := NIL;
    GlobalState := Idling;
    while GlobalState<>Done do begin
        GetEvent(E);
        HidePointer;
        { Check if menu item.  If so, let command well do it }
        if (E.typ=LBUTTONDOWN) and CW.PtInRegion( E.x, E.y) then begin
                repeat GetEvent(E) until E.typ=LBUTTONUP;
                if CW.PtInRegion( E.x, E.y) then CW.Process( E.x, E.y);
                end
        else    MHandler( E );
        ShowPointer;
        end;    { while State<>done }

end;

begin
    Initialize;
    ProcessEvents;
    Finalize;
end.